home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1985 Summer / rerun-1985-summer-side-b.d64 / number puzzle (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  4KB  |  136 lines
  1. 0 rem fifteen puzzle v 4.4 for c-64,written for trs-80 by w.l.colsher
  2. 10 rem kb/microcomp.,v.5,p.114,feb.1981.modified and converted for c-64 by
  3. 20 rem z.szepesi 2611 saybrook drive,pittsburgh,pa 15235
  4. 30 poke53281,13:poke53280,2:print"[147][144]            fifteen puzzle."
  5. 40 print"            [184][184][184][184][184][184][184][184][184][184][184][184][184][184][184]"
  6. 50 print"  **do you need instructions?"
  7. 60 print"    press 'y', or any other key for no."
  8. 70 geta$:ifa$=""then70
  9. 80 ifa$="y"thengosub1310
  10. 90 rem ***initialisation************************
  11. 100 dim a(20):m=0:s=54272:print"[147]"
  12. 110 a$=" [213][195][195][195][195][178][195][195][195][195][178][195][195][195][195][178][195][195][195][195][201]":rem sh=shift;cm=commodore key in following
  13. 120 rem space;sh u;4 sh c;cm r;4 sh c;cm r;4 sh c;cm r;4 sh c;sh i
  14. 130 b$=" [171][192][192][192][192][219][192][192][192][192][219][192][192][192][192][219][192][192][192][192][179]"
  15. 140 rem space;cm q;4 sh c;sh +;4 sh c;sh +;4 sh c;sh +;4 sh c;cm w
  16. 150 c$=" [194] [160][160][160][221][160][160][160][160][221][160][160][160][160][221][160][160][160][160][194]"
  17. 160 rem space;sh b;4 space;sh b;4 space;sh b;4 space;sh b;4 space;sh b
  18. 170 d$=" [202][195][195][195][195][177][195][195][195][195][177][195][195][195][195][177][195][195][195][195][203]"
  19. 180 rem space;sh j;4 sh c;cm e;4 sh c;cm e;4 sh c;cm e;4 sh c;sh k
  20. 190 printa$:fori=1to3
  21. 200 printc$:printc$:printb$:nexti
  22. 210 printc$:printc$:printd$:ifq=1then return
  23. 220 print"  **wait please"
  24. 230 forx=1to16:a(x)=0:next:rem **creating a set of random numbers**
  25. 240 fori=1to16
  26. 250 x=int(16*rnd(rnd(0)))+1:ifa(x)then250
  27. 260 a(x)=i:next
  28. 270 gosub510:ti$="000000":iff=0then230
  29. 280 print:gosub610:print:print"                ":rem 17 spaces
  30. 290 print"[145]  *your move";:x$="":x1$="":rem **play starts*****
  31. 300 getx$:ifx$=""then300
  32. 310 ifx$="_"thenx=1:goto350
  33. 320 ifx$<>"1"goto340
  34. 330 getx1$:ifx1$=""goto330
  35. 340 x$=x$+x1$:x=val(x$)
  36. 350 printx:gosub410:gosub710:iff then370
  37. 360 print"  *illegal move,re-enter":goto280
  38. 370 a(x+f)=a(x):a(x)=16:goto910
  39. 380 m=m+1:goto280
  40. 400 rem ***convert number to location in array***
  41. 410 fori=1to16:ifa(i)=xthen430
  42. 420 next
  43. 430 x=i:return
  44. 500 rem ***verify if solution is possible********
  45. 510 f=0:su=0:fori=1to15:forj=i+1to16
  46. 520 ifa(i)>a(j)thensu=su+1
  47. 530 nextj:nexti:restore
  48. 540 fori=1to8:readx:ifa(x)=16thensu=su+1
  49. 550 nexti
  50. 560 a=int(su/2):ifa*2=suthenf=1
  51. 570 return
  52. 580 data2,4,5,7,10,12,13,15
  53. 600 rem ***display game board********************
  54. 610 print"":print:fori=1to4:print
  55. 620 printspc(1):forj=1to4:n=a((i-1)*4+j):printspc(1);:n$=str$(n)
  56. 630 ifn<10thenprint" ";
  57. 640 ifn=16then n$="   "
  58. 650 printn$;spc(1);
  59. 660 nextj:print:print
  60. 670 nexti
  61. 680 print:return
  62. 700 rem ***check for legal move******************
  63. 710 f=0:ifx>16then return
  64. 720 if(x=4orx=8orx=12)anda(x+1)=16thenreturn
  65. 730 if(x=5orx=9orx=13)anda(x-1)=16thenreturn
  66. 740 ifx+1>16then760
  67. 750 ifa(x+1)=16thenf=1
  68. 760 ifx-1<=0then780
  69. 770 ifa(x-1)=16thenf=-1
  70. 780 ifx+4>16then800
  71. 790 ifa(x+4)=16thenf=4
  72. 800 ifx-4<0then820
  73. 810 ifa(x-4)=16thenf=-4
  74. 820 iff thenprint"                          ":rem 26 spaces
  75. 830 return
  76. 900 rem ***check for a win***********************
  77. 910 fori=1to16
  78. 920 ifa(i)<>ithen380
  79. 930 next
  80. 940 gosub610:t$=ti$
  81. 950 gosub1110:print"[147]  *congratulations!!!"
  82. 960 print"   you did it in only"m"moves!!"
  83. 970 print"  *and you needed "val(mid$(t$,1,2))"hour,";
  84. 980 print val(mid$(t$,3,2))"minutes"
  85. 990 print"   and"val(mid$(t$,5,2))"seconds."
  86. 1000 print"  **press 'y' to play again or              any other key to end."
  87. 1010 geta$:ifa$=""then1010
  88. 1020 ifa$="y"thenclr:goto100
  89. 1030 end
  90. 1100 rem ***sound subroutines*********************
  91. 1110 forl=stos+24:pokel,0:next:pokes+24,15
  92. 1120 pokes+5,0:pokes+12,0:pokes+19,0:pokes+6,240:pokes+13,240:pokes+20,240
  93. 1130 restore
  94. 1140 fori=1to8:readz:next
  95. 1150 readh1,h2,h3:ifh1=-1thenforl=stos+24:pokel,0:next:return
  96. 1160 readl1,l2,l3,d:pokes+1,h1:pokes+8,h2:pokes+15,h3
  97. 1170 pokes,l1:pokes+7,l2:pokes+14,l3:pokes+4,17:pokes+11,17:pokes+18,17
  98. 1180 fort=1tod:next:pokes+4,16:pokes+11,16:pokes+18,16:fort=1to50:next:goto1150
  99. 1190 data25,12,6,30,143,71,100
  100. 1200 data25,12,6,30,143,71,100
  101. 1210 data25,12,6,30,143,71,100
  102. 1220 data19,9,4,239,247,251,400,0,0,0,0,0,0,100
  103. 1230 data22,11,5,96,48,152,100
  104. 1240 data22,11,5,96,48,152,100
  105. 1250 data22,11,5,96,48,152,100
  106. 1260 data18,9,4,209,104,180,800,-1,1,1
  107. 1300 rem ***instructions**************************
  108. 1310 print"[147]     fifteen puzzle"
  109. 1320 print"     [183][183][183][183][183][183][183][183][183][183][183][183][183][183]"
  110. 1330 print" *the object of the fifteen puzzle is"
  111. 1340 print" to move the numbers around, so that"
  112. 1350 print" they are in order from 1 to 15."
  113. 1360 print" a move is made by typing in the number"
  114. 1370 print" you wish to move. however, if you"
  115. 1380 print" want to move the number '1', press"
  116. 1390 print" instead the left arrow ('_')."
  117. 1400 print" *the number to be moved must be"
  118. 1410 print" adjacent to the empty square."
  119. 1420 print" the typed number then moves into the"
  120. 1430 print" empty square."
  121. 1440 print" *do not press return after typing the"
  122. 1450 print" number."
  123. 1460 print" *you win, when the board looks like the"
  124. 1470 print"[145]  figure which follows:"
  125. 1480 print" **press any key to continue"
  126. 1490 geta$:ifa$=""then1490
  127. 1500 q=1:gosub100
  128. 1510 fori=1to16:a(i)=i:nexti
  129. 1520 gosub610
  130. 1530 print" **press any key to start"
  131. 1540 geta$:ifa$=""then1540
  132. 1550 q=0:clr:goto100
  133. 1560 print" **press anz key to continue"
  134. 1570 geta$:ifa$=""then1570
  135. 1580 print"[147]":return
  136.